home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / widutil.pro < prev    next >
Text File  |  1997-07-08  |  11KB  |  444 lines
  1. ;
  2. ; $Id: widutil.pro,v 1.12 1997/01/15 03:11:50 ali Exp $
  3. ;
  4. ;  WidUtil
  5. ;   Miscellaneous Utility functions and procedures
  6. ;
  7. ; Copyright (c) 1993-1997, Research Systems, Inc.  All rights reserved.
  8. ;   Unauthorized reproduction prohibited.
  9. ;
  10. ; MODIFICATION HISTORY
  11. ;       Written by:     Joshua Goldstein,       12/93
  12. ;
  13. ;
  14.  
  15.  
  16.  
  17. ;
  18. ;  Event handler loop for Error dialog box
  19. ;
  20. PRO ErrorEvent, Event
  21.  
  22.     ; The only event possible is a 'Done' so we don't bother
  23.     ; to check, just bring the dialog down
  24.  
  25.     WIDGET_CONTROL, Event.top, /DESTROY
  26. END
  27.  
  28.  
  29. ;
  30. ;  ErrorDialog
  31. ;       Create a dialog box and put an error message in it
  32. ;   Message can be a string or an array of strings
  33. ;
  34. PRO ErrorDialog, Parent, Msg
  35.  
  36.     ;   Position the error dialog on top of its parent
  37.  
  38.     WIDGET_CONTROL, Parent, TLB_GET_OFFSET=Off
  39.     Base    = WIDGET_BASE(/COLUMN, GROUP_LEADER=Parent, /MODAL, $
  40.                           TITLE='ERROR!', $
  41.                           XOFFSET=Off[0]+50, YOFFSET=Off[1]+50)
  42.  
  43.     ;   Add a label(line) for each line of the message
  44.     FOR I=1,N_ELEMENTS(Msg) DO BEGIN
  45.         Label   = WIDGET_LABEL(base,VALUE=Msg[I-1])
  46.     ENDFOR
  47.  
  48.     ;   Make an acknowledge button for the user to press
  49.     ;   We move it over (looks better).  Of course the fixed
  50.     ;   offset stuff is not the best solution but seems to work
  51.     Ok      = WIDGET_BUTTON(Base, VALUE='  OK  ', XOFF=70)  ; Bad?
  52.  
  53.     WIDGET_CONTROL, Base, /REALIZE
  54.     XMANAGER, 'WidError', Base, EVENT_HANDLER='ErrorEvent'
  55. END
  56.  
  57. ;
  58. ;  Qstring(String)
  59. ;   Return a string which can be included in single quotes. That is.
  60. ;   double every single quote. E.g. QString("Do's 'n Don'ts") returns
  61. ;   Do''s ''n Don''ts.  Note that there is a bug in the IDL parser
  62. ;   which barfs on leading single quotes: '''' is a syntax error
  63. ;
  64. ;   Side Effect: Due to the nature of IDL variable passing, if
  65. ;   the string passed in is a named variable it will be altered
  66. ;
  67. FUNCTION Qstring, String
  68.  
  69.     Len         = STRLEN(String)+1                  ; Starting length
  70.     PrevQuote   = 0                                 ; Previous quote pos
  71.     Quote       = STRPOS(String, "'", PrevQuote)    ; Current quote pos
  72.  
  73.     WHILE Quote NE -1 DO BEGIN                          ; given xx'yy
  74.         Front       = STRMID(String,0,Quote+1)          ;   Front = xx'
  75.         Back        = STRMID(String,Quote, Len - Quote) ;-) Back  = 'yy
  76.         String      = Front + Back                      ; xx' + 'yy
  77.         Len         = Len + 1                           ; string got longer
  78.  
  79.         PrevQuote   = Quote + 2                         ; quote is not previous quote
  80.         Quote       = STRPOS(String, "'", PrevQuote)
  81.     ENDWHILE
  82.     RETURN, String
  83. END
  84.  
  85.  
  86. ;
  87. ;  ClearVar
  88. ;   Reset a variable to <UNDEFINED> if it isn't already.
  89. ;
  90. PRO ClearVar, Var
  91.     IF N_ELEMENTS(Var) NE 0 THEN Dummy  = TEMPORARY(Var)
  92. END
  93.  
  94.  
  95. ;
  96. ;  DoList
  97. ;       Given the pointer to a list of objects, perform a FIXED
  98. ;   function on each object in the list of the form:
  99. ;               Procstr,Ptr
  100. ;
  101. PRO DoList, Ptr, ProcStr
  102.  
  103.     WHILE Ptr NE 0L DO BEGIN
  104.         Next    = NextPtr(Ptr)
  105.         Dummy   = EXECUTE(ProcStr + ",Ptr")
  106.         Ptr     = Next
  107.     ENDWHILE
  108. END
  109.  
  110. ;
  111. ;  DoFList
  112. ;       Given the pointer to a list of objects, perform an I/O
  113. ;   function on each object in the list of the form:
  114. ;               Procstr,Unit,Ptr
  115. ;
  116. PRO DoFList, Ptr, ProcStr, Unit
  117.  
  118.     WHILE Ptr NE 0L DO BEGIN
  119.         Next    = NextPtr(Ptr)
  120.         Dummy   = EXECUTE(ProcStr + ",Unit,Ptr")
  121.         Ptr     = Next
  122.     ENDWHILE
  123. END
  124.  
  125. ;
  126. ;  DoFList2
  127. ;       Given the pointer to a list of objects, perform an I/O
  128. ;   function on each object in the list of the form:
  129. ;               Procstr,Unit1,Unit2,Ptr
  130. ;
  131. PRO DoFList2, Ptr, ProcStr, Unit1, Unit2
  132.  
  133.     WHILE Ptr NE 0L DO BEGIN
  134.         Next    = NextPtr(Ptr)
  135.         Dummy   = EXECUTE(ProcStr + ",Unit1,Unit2,Ptr")
  136.         Ptr     = Next
  137.     ENDWHILE
  138. END
  139.  
  140.  
  141. ;
  142. ;  GetType
  143. ;   Get the Type field out of an object.
  144. ;
  145. PRO GetType, Ptr, Type
  146.     Ptr2Obj, Ptr, Obj
  147.     Type    = Obj.Type
  148.     Obj2Ptr, Obj, Ptr
  149. END
  150.  
  151.  
  152. ;
  153. ;  SetTag
  154. ;       Set an arbitrary field in an object given a pointer
  155. ;       to the object, the tag and its new value
  156. ;
  157. PRO SetTag, Ptr, Tag, Value
  158.     Ptr2Obj, Ptr, Obj
  159.     Dummy       = EXECUTE("Obj."+ Tag + "= Value")
  160.     Obj2Ptr, Obj, Ptr
  161. END
  162.  
  163.  
  164. ;
  165. ;  NewId
  166. ;   Create a new name for an object
  167. ;
  168. FUNCTION NewId
  169.  
  170.   COMMON WidEd_Comm
  171.  
  172.     New         = STRTRIM(LastId,2)
  173.     LastId      = LastId + 1
  174.     RETURN, New
  175. END
  176.  
  177.  
  178. ;
  179. ;  VarId
  180. ;   Return the logical name of an object
  181. ;
  182. FUNCTION VarId, Ptr
  183.     Ptr2Obj, Ptr, Obj
  184.     VarName = Obj.Type + Obj.Id
  185.     Obj2Ptr, Obj, Ptr
  186.     RETURN, VarName
  187. END
  188.  
  189.  
  190. ;
  191. ;  GetId
  192. ;   Return what we think would be the best symbolic name for an object
  193. ;   This is either: the name the user gave it, its value(title) or its
  194. ;   logical name
  195. ;
  196. FUNCTION GetId, Ptr
  197.  
  198.   COMMON WidEd_Comm
  199.  
  200.     IF Ptr EQ TopPtr THEN RETURN, 'Top Base'
  201.  
  202.     Ptr2Obj, Ptr, Obj
  203.  
  204.     IF Obj.Name NE '' THEN BEGIN
  205.         Id  = Obj.Name
  206.         Obj2Ptr, Obj, Ptr
  207.         RETURN, Id
  208.     ENDIF
  209.  
  210.     IF (Obj.Type EQ 'LABEL' OR Obj.Type EQ 'BUTTON') THEN BEGIN
  211.         IF Obj.Value NE '' THEN BEGIN
  212.             Id  = Obj.Value
  213.             Obj2Ptr, Obj, Ptr
  214.             RETURN, Id
  215.         ENDIF
  216.     ENDIF
  217.  
  218.     IF Obj.Type EQ 'FIELD' OR Obj.Type EQ 'SLIDER' OR $
  219.        Obj.Type EQ 'FSLID' THEN BEGIN
  220.  
  221.         IF Obj.Title NE '' THEN BEGIN
  222.             Id  = Obj.Title
  223.             Obj2Ptr, Obj, Ptr
  224.             RETURN, Id
  225.         ENDIF
  226.     ENDIF
  227.  
  228.     IF Obj.UValue NE '' THEN    Id = Obj.UValue $
  229.     ELSE                        Id = Obj.Type + Obj.Id
  230.     Obj2Ptr, Obj, Ptr
  231.     RETURN, Id
  232. END
  233.  
  234.  
  235. ;
  236. ;  UValue
  237. ;   If the user has not provided a UVALUE for an object we do so that
  238. ;   we can write an event handler.
  239. ;
  240. FUNCTION UValue, Obj, Ptr
  241.     IF Obj.UValue NE '' THEN RETURN, Obj.UValue
  242.     RETURN, Obj.Type + Obj.Id
  243. END
  244.  
  245.  
  246. ;
  247. ;  HasChildren
  248. ;   Returns TRUE if the object has children or is a base object
  249. ;   and has no children but thats OK. Otherwise return FALSE.
  250. ;
  251. FUNCTION HasChildren, Ptr, NONE_OK=NoneOk
  252.  
  253.     ;   Bad pointers don't have children
  254.     IF WIDGET_INFO(Ptr, /VALID_ID) EQ 0 THEN RETURN, 0
  255.  
  256.     Ptr2Obj, Ptr, Obj
  257.     Name    = TAG_NAMES(Obj, /STRUCTURE)
  258.  
  259.     ;   Only Base objects can have children (so far)
  260.     IF Name EQ 'WE_BASE' THEN BEGIN
  261.  
  262.         ; Actually has children or could have children but thats enough?
  263.         IF Obj.Children NE 0 OR KEYWORD_SET(NoneOk) THEN BEGIN
  264.             Obj2Ptr, Obj, Ptr
  265.             RETURN, 1
  266.         ENDIF
  267.     ENDIF
  268.  
  269.     ;   Have a base object but it has no children and NoneOk is false
  270.  
  271.     Obj2Ptr, Obj, Ptr
  272.     RETURN, 0
  273. END
  274.  
  275.  
  276. ;
  277. ;  Dirty_Event
  278. ;   Event handler for the asking the user Dirty dialog (see below)
  279. ;
  280. PRO Dirty_Event, Event
  281.  
  282. COMMON  WidDirty_Comm, DoCall
  283.  
  284.     WIDGET_CONTROL, Event.Id, GET_UVALUE=Ev
  285.  
  286.     ;   Save First?
  287.     IF Ev EQ "Yes" THEN FileSave
  288.  
  289.     ;   Do we want to do whatever it is that we were asking about
  290.     ;   saving before doing? We do for Yes or No but not Cancel
  291.     DoCall  = (Ev NE "Cancel")
  292.  
  293.     ;   Done
  294.     WIDGET_CONTROL, Event.Top, /DESTROY
  295. END
  296.  
  297.  
  298. ;
  299. ;  Dirty
  300. ;   Give a user a chance to save changes before destroying the
  301. ;   object tree.  A 'Do you want to save the object tree before
  302. ;   doing XXX?' failsafe.
  303. ;
  304. ;   The way this works might be a tad confusing.
  305. ;   Run the widget builder, add some widget and hit 'Quit'.
  306. ;   That will make this a lot more understandable.
  307. ;
  308. PRO Dirty, Parent, Thing, Call
  309.  
  310. COMMON  WidDirty_Comm, DoCall
  311.  
  312.   COMMON WidEd_Comm    
  313.  
  314.     ;   If there is no chance of loosing data then just do it
  315.  
  316.     IF Dirty EQ 0 THEN Dummy=EXECUTE(Call) $
  317.     ELSE BEGIN
  318.  
  319.         ;   Position the 'Wanna do <Thing>?' dialog on top of parent
  320.         WIDGET_CONTROL, Parent, TLB_GET_OFFSET=Off
  321.         Base    = WIDGET_BASE(/COLUMN, GROUP_LEADER=Parent, /MODAL, $
  322.                   XOFFSET=Off[0]+50, YOFFSET=Off[1]+50)
  323.  
  324.         ;   Build question
  325.         Label   = WIDGET_LABEL(Base, VALUE="Save changes before");
  326.         Label   = WIDGET_LABEL(Base, VALUE=Thing+"?");
  327.  
  328.         ;   Build possible answers
  329.         Base1   = WIDGET_BASE(Base, /ROW)
  330.         Btn     = WIDGET_BUTTON(Base1, VALUE="  Yes  ", UVALUE="Yes")
  331.         Btn     = WIDGET_BUTTON(Base1, VALUE="   No  ", UVALUE="No")
  332.         Btn     = WIDGET_BUTTON(Base1, VALUE=" Cancel", UVALUE="Cancel")
  333.  
  334.         ;   Wait for user to answer your question
  335.         WIDGET_CONTROL, Base, /REALIZE
  336.         XMANAGER, 'WidError', Base, EVENT_HANDLER='Dirty_Event'
  337.  
  338.         ;   Event handler will set DoCall to TRUE if the user wants
  339.         ;   to do whatever it is (Call).  Have to do this here to prevent
  340.         ;   XMANAGER MODAL looping bug.
  341.  
  342.         IF DoCall THEN Dummy = EXECUTE(Call)
  343.     ENDELSE
  344. END
  345.  
  346.  
  347. ;
  348. ;  SAddCmd
  349. ;   Append a string keyword to a command string. Only append
  350. ;   keyword if value is not the null string ('') or the FORCE
  351. ;   keyword is set
  352. ;
  353. ;   E.g.
  354. ;       Cmd='WidCre(XXX' & SAddCmd, Cmd, "Hello", "VALUE"
  355. ;       HELP,Cmd
  356. ;   CMD STRING  = "WidCre(XXX,VALUE='Hello'"
  357. ;
  358. PRO SAddCmd, Cmd, Value, Keyword, FORCE=Force
  359.     IF Value NE '' OR KEYWORD_SET(FORCE) THEN $
  360.         Cmd = Cmd + ',' + Keyword + "='" + QString(Value) + "'"
  361. END
  362.  
  363.  
  364. ;
  365. ;  IAddCmd
  366. ;   Same as SAddCmd but for integer values. Only appends keyword
  367. ;   if value is non-zero or FORCE keyword set.
  368. ;
  369. PRO IAddCmd, Cmd, Value, Keyword, FORCE=Force
  370.     IF Value NE 0 OR KEYWORD_SET(FORCE) THEN $
  371.         Cmd = Cmd + ',' + Keyword + '=' + STRTRIM(Value,2)
  372. END
  373.  
  374.  
  375. ;
  376. ;  SetFocus
  377. ;   Set the focus to the given widget.  Id should be either:
  378. ;   a TEXT widget or a compound widget (base) whose first text object
  379. ;   in it is what should receive the keyboard focus
  380. ;
  381. PRO SetFocus, Id
  382.  
  383.     IF WIDGET_INFO(Id, /TYPE) EQ 3 THEN BEGIN   ; Text Widget?
  384.         TextId  = Id
  385.     ENDIF ELSE BEGIN
  386.         TextId  = WIDGET_INFO(Id, /CHILD)       ; Assume Base
  387.  
  388.         ;   Hunt through children looking for first text widget
  389.         WHILE TextId NE 0 AND WIDGET_INFO(TextId,/TYPE) NE 3 DO BEGIN
  390.             TextId  = WIDGET_INFO(TextId, /SIBLING)
  391.         ENDWHILE
  392.     ENDELSE
  393.  
  394.     WIDGET_CONTROL, TextId, /INPUT_FOCUS        ; Set keyboard focus
  395. END
  396.  
  397.  
  398. ;
  399. ;  SetNextFocus
  400. ;   If the user has hit <CR> (event.update will be TRUE) and we
  401. ;   can find the current focus then determine the next focus and
  402. ;   give it the keyboard focus.
  403. ;
  404. PRO SetNextFocus, Binfo, Event
  405.  
  406.     ;   Look for the current id in our list of known foci
  407.  
  408.     Current        = WHERE(BInfo.Foci EQ Event.Id, Count)
  409.     IF Count EQ 1 THEN BEGIN
  410.  
  411.         ;   Did user hit <CR>? Goto next focus if they did
  412.         IF Event.Update THEN BEGIN
  413.             ;   Next is a relative term (wrap from last to first)
  414.             Current = (Current[0] + 1) MOD N_ELEMENTS(BInfo.Foci)
  415.             SetFocus, BInfo.Foci[Current]
  416.         ENDIF
  417.     ENDIF
  418. END
  419.  
  420.  
  421. ;
  422. ;  GetValue
  423. ;   Given an object with an text field for a value (STRARR)
  424. ;   get that value.  If the value is nil then use the default (NoName)
  425. ;   value instead: Returning <UNDEFINED> is not good.
  426. ;
  427. PRO GetValue, Obj, Names, NoName
  428.  
  429. ;   (c.f. BuildEdit in widbuild.pro)
  430.  
  431. ;   IF Obj.ValueType EQ 0 THEN BEGIN
  432.  
  433.         Ptr2Obj, Obj.Value1, Names, /COPY
  434.         IF N_ELEMENTS(Names) EQ 0 THEN Names=NoName
  435.  
  436. ;   ENDIF ELSE BEGIN
  437. ;       Unsupportable.
  438. ;       Names = '<User Code>'
  439. ;   ENDELSE
  440. END
  441.  
  442. PRO WidUtil
  443. END
  444.